home *** CD-ROM | disk | FTP | other *** search
- /* ArchiveFolder.rexx 1.2 02-Jun-97 by Kai Nikulainen
- **
- ** Renames messages in a folder to their subjects and moves them into a
- ** .lha archive.
- **
- ** Do not add messages to an older archive, because that could cause
- ** clashes with filenames and all messages would not be saved!
- **
- ** Mail your comments and bug reports to knikulai@utu.fi */
-
- options results
-
- DeleteAll='yes' /* If yes, all files left in the folder will be deleted after archiving*/
- RemSpaces='no' /* If yes, spaces are removed. Otherwise they are translated to _ */
- Arc='c:lha a' /* Use this command to archive the messages */
- Defpath='Work:' /* Default path for the file requester */
- tags='rt_pubscrname=YAMSCREEN' /* Change here the name of the screen YAM runs */
-
- /* The following lines define substrings which are removed from the */
- /* filenames. Substrings are case insensitive! */
- dels=2 /* How many undesired substrings are there? */
- del.1='Re: ' /* Note that words are removed in the order they are given */
- del.2='Re:' /* So, if 'Re:' would come before 'Re: ' that might leave a space*/
- /* in the beginning of filenames */
-
- BadChars='*:/?"'/* These chars will be translated to _ */
-
- call addlib('rexxsupport.library',0,-30,0)
- call addlib('rexxreqtools.library',0,-30,0)
-
- do d=1 to dels
- del.d=upper(del.d)
- end
-
- sc=0
- address 'YAM'
- 'MailUpdate' /* Let's make sure the index is up to date */
- 'GetFolderInfo Max' /* How many messages are there? */
- n=result
-
- 'GetFolderInfo Path' /* Where is the folder */
- fp=result
- if pos(':',fp)=0 then fp='YAM:'fp
- if right(fp,1)~='/' & right(fp,1)~=':' then fp=fp'/'
-
- 'GetFolderInfo Name' /* What's it's name */
- arcname=result date()
- if upper(RemSpaces)~='YES' then
- arcname=translate(arcname,'_',' ')
-
- arcname=compress(arcname,' ' || BadChars)
- arcname=rtfilerequest(DefPath,arcname,'Select archive name',,tags)
- if arcname='' then exit
-
- 'Hide' /* It's faster to scan all messages while YAM is hidden */
- do m=0 to n-1 /* Do for all messages in folder: */
- 'SetMail' m /* Select a message */
- 'GetMailInfo File' /* Get the filename */
- file=result /* Save the filename */
- 'GetMailInfo Subject' /* Guess what it does now? */
- subj=result
- do d=1 to dels
- p=pos(del.d,upper(subj))
- do while p>0
- subj=left(subj,p-1) || substr(subj,p+length(del.d))
- p=pos(del.d,upper(subj))
- end
- end
- subj=translate(subj,'_',BadChars)
- if upper(RemSpaces)='YES' then
- subj=Compress(subj)
- else
- subj=Translate(subj,'_',' ')
- if length(subj)>30 then subj=left(subj,30) /* the name may be shortened */
- if subj='' then subj='No subject' /* every message needs one...*/
- num=CheckName(subj) /* find duplicates */
- if length(subj || num)>30 then
- subj=left(subj,30-length(num)) || num
- else
- subj=subj || num
- address command 'Filenote' file file /* this might help restoring things*/
- address command 'Rename' file '"'fp || subj'"'
-
- end /* do m */
-
- /* Let's open a window... */
- Call Close(STDOUT)
- Call Close(STDIN)
-
- Call Open(STDOUT,'CON:1/11/600/180/ArchiveFolder.rexx Output/CLOSE/WAIT/SCREEN'scrn,'w')
- Call Pragma('*',STDOUT)
-
- address command arc '"'arcname'"' fp
- if upper(DeleteAll)='YES' then address command 'delete' fp'#?'
-
- Say 'You can close the window now'
- 'MailUpdate'
- 'Show'
- exit
-
- CheckName:
- parse arg s
- i=1
- s=upper(s)
- do while i<sc & s~=su.i
- i=i+1
- end
- if s=su.i then do
- copies.i=copies.i+1
- c='['copies.i']'
- end
- else do
- sc=sc+1
- su.sc=s
- copies.sc=0
- c=''
- end
- return c
-